home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Module source / zUtilmod.txt < prev    next >
Text File  |  1997-11-10  |  2KB  |  94 lines
  1. \ Various utilities
  2.  
  3. : CHK
  4.     ResError  ?dup
  5.     IF  3 beep  3 beep  cr
  6.         dup -48 =
  7.         IF    ." You can't save using the same name as the running" cr
  8.             ." application.  Please try again with a different name." cr
  9.         ELSE
  10.             ." Res error# " .  cr
  11.         THEN
  12.         QUIT
  13.     THEN  ;
  14.  
  15.  
  16. \ Class RES+ adds methods to Resource to allow various modifications
  17. \ to resources.  We'll put more in as we need them.
  18.  
  19. :class    RES+  super{ resource }
  20.  
  21. objPtr    TEMPRES  class_is  res+
  22.  
  23. :m CHANGED:    get: self  ChangedResource  ;m
  24.  
  25. :m ADD:  { addr len -- }
  26.     get: self
  27.     get: resType  get: ID
  28.     addr len >str255  AddResource  chk  ;m
  29.  
  30. :m REMOVE:
  31.     get: self  RemoveResource  chk  ;m
  32.  
  33. :m SETATTRS:    \ ( n -- )
  34.     get: self  swap  SetResAttrs  chk
  35.     changed: self  ;m
  36.  
  37.  
  38. ;class
  39.  
  40.  
  41.     string    TEMP$
  42.     res+    TEMPRES
  43.  
  44.  
  45. : (.MOD)  { theCfa dummy \ modObj -- }
  46.     theCfa  mod? NIF  drop  EXIT  THEN
  47.     >obj  -> modObj
  48.     cr  0 -> out  .id: [ modObj ]
  49.     15 out -  spaces
  50.     print: [ modObj ]
  51. ;
  52. \    base: [ modObj ]  dup
  53. \    NIF  drop  ." not loaded"  ELSE  u.h  THEN
  54. \    keep?: [ modObj ]    IF  type# 174 ( *** Keep *** )  THEN
  55. \    locked?: [ modObj ]    IF  type# 175 ( *** Locked *** )  THEN  ;
  56.  
  57. : .MODS        \ Lists modules and their load status.
  58.     ['] (.mod)  0 trav
  59.     cr  ;
  60.  
  61.  
  62. : .MSGS        \ Lists all error etc. messages and their numbers.
  63.     300 -60  DO
  64.         ?pause cr
  65.         i . space  i  getstring
  66.         dup IF  type  ELSE  2drop  THEN
  67.     LOOP  ;
  68.  
  69.  
  70. : ADDMSG  { msg# addr len -- }
  71.     msg# getstring  abort" number already assigned"  drop
  72.     addr  pad 1+  len  cmove
  73.     len pad c!
  74.     new: temp$
  75.     pad  len 1+  put: temp$
  76.     'type STR   msg#  set: tempRes  handle: temp$  put: tempRes
  77.     0 0  add: tempRes
  78.     $ 20  setAttrs: tempRes  ;
  79.  
  80. : REMOVEMSG  { msg# -- }
  81.     msg# getstring  nip  0EXIT
  82.     'type STR   msg#  set: tempRes  getnew: tempRes
  83.     remove: tempRes  release: tempRes  ;
  84.  
  85.  
  86. : GETINDSTR  { resID idx \ addr -- addr len }
  87.     openMR
  88.     'type STR#  resID  getRes  dup NIF  0  EXIT  THEN
  89.     ( handle )  @  -> addr
  90.     idx  addr w@  >=  IF  0 0  EXIT  THEN
  91.     2 ++> addr
  92.     idx 0 ?DO  addr count +  -> addr  LOOP
  93.     addr count  ;
  94.